home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / vbfont / fonts.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-05-08  |  6.4 KB  |  215 lines
  1. VERSION 2.00
  2. Begin Form Fonts 
  3.    BackColor       =   &H00FFFFFF&
  4.    Caption         =   "Fonts"
  5.    ClientHeight    =   3390
  6.    ClientLeft      =   1170
  7.    ClientTop       =   1545
  8.    ClientWidth     =   3840
  9.    Height          =   3795
  10.    Icon            =   FONTS.FRX:0000
  11.    Left            =   1110
  12.    LinkMode        =   1  'Source
  13.    LinkTopic       =   "Form1"
  14.    MaxButton       =   0   'False
  15.    ScaleHeight     =   3390
  16.    ScaleWidth      =   3840
  17.    Top             =   1200
  18.    Width           =   3960
  19.    Begin OptionButton Opt_Bold 
  20.       Caption         =   "Bold"
  21.       Height          =   255
  22.       Left            =   240
  23.       TabIndex        =   5
  24.       Top             =   3000
  25.       Width           =   1215
  26.    End
  27.    Begin CommandButton Cmd_End 
  28.       Caption         =   "&End"
  29.       Height          =   375
  30.       Left            =   2520
  31.       TabIndex        =   6
  32.       Top             =   2880
  33.       Width           =   1095
  34.    End
  35.    Begin OptionButton Opt_Ital 
  36.       Caption         =   "Italic"
  37.       Height          =   255
  38.       Left            =   240
  39.       TabIndex        =   4
  40.       Top             =   2700
  41.       Width           =   1215
  42.    End
  43.    Begin CommandButton Cmd_Prt 
  44.       Caption         =   "&Print List"
  45.       Height          =   375
  46.       Left            =   2520
  47.       TabIndex        =   3
  48.       Top             =   2400
  49.       Width           =   1095
  50.    End
  51.    Begin OptionButton Opt_Norm 
  52.       Caption         =   "Normal"
  53.       Height          =   255
  54.       Left            =   240
  55.       TabIndex        =   7
  56.       Top             =   2400
  57.       Width           =   1215
  58.    End
  59.    Begin PictureBox Pict_Font 
  60.       FontBold        =   0   'False
  61.       FontItalic      =   0   'False
  62.       FontName        =   "MS Sans Serif"
  63.       FontSize        =   8.25
  64.       FontStrikethru  =   0   'False
  65.       FontUnderline   =   0   'False
  66.       Height          =   615
  67.       Left            =   240
  68.       ScaleHeight     =   585
  69.       ScaleWidth      =   3345
  70.       TabIndex        =   1
  71.       Top             =   1680
  72.       Width           =   3375
  73.    End
  74.    Begin ListBox Lst_Size 
  75.       Height          =   1395
  76.       Left            =   2880
  77.       TabIndex        =   2
  78.       Top             =   120
  79.       Width           =   855
  80.    End
  81.    Begin ListBox Lst_Face 
  82.       Height          =   1395
  83.       Left            =   240
  84.       Sorted          =   -1  'True
  85.       TabIndex        =   0
  86.       Top             =   120
  87.       Width           =   2295
  88.    End
  89. ' FontView v1.0 by Charles K. Snider 10/91
  90. ' Send any and all comments to: Compuserve 73730,1315
  91. ' Declare variables
  92. Dim FaceName As String
  93. Sub Cmd_End_Click ()
  94.     ' End program
  95.     End
  96. End Sub
  97. Sub Cmd_Prt_Click ()
  98.     ' Print routine
  99.     ' Set Error trap - go to sub CheckError if detected
  100.     On Error GoTo CheckError:
  101.     ' Change mouse cursor to hourglass
  102.     Fonts.MousePointer = 11
  103.     ' Print header
  104.     Header$ = "Available Screen Fonts"
  105.     Printer.Print Header$ + Chr$(13) + Chr$(10)
  106.     ' Get screen fonts and send list to printer
  107.     For K% = 0 To Screen.FontCount - 1
  108.         FontName = Screen.Fonts(K%)
  109.         Printer.Print Screen.Fonts(K%)
  110.     Next K%
  111.     ' Restore font to default
  112.     FontName = Screen.Fonts(0)
  113.     ' Print number of available fonts
  114.     Printer.Print Chr$(13) + Chr$(10) + "Number Of Fonts: "; Screen.FontCount
  115.     ' End printing
  116.     Printer.EndDoc
  117.     ' restore cursor to default
  118.     Fonts.MousePointer = 0
  119.     ' avoid executing error handler if error occurs ("exit")
  120. Exit Sub
  121. ' branch here if error occurs
  122. CheckError:
  123.     ' display error message
  124.     MsgBox Error$(482), 16
  125. End Sub
  126. Sub Form_Click ()
  127.     ' Display "About Box"
  128.     Msg$ = "Font Viewer by Charles Snider" + Chr$(13) + Chr$(10) + "Compuserve 73730,1315"
  129.     MsgBox Msg$, 64, "Font Viewer v1.0"
  130. End Sub
  131. Sub Form_Load ()
  132.     ' Center on screen
  133.     Move (Screen.Width - Width) \ 2, (Screen.Height - Height) \ 2
  134.     ' Get list of screen fonts and add to list box
  135.     For I% = 0 To Screen.FontCount - 1
  136.         FontName = Screen.Fonts(I%)
  137.         Lst_Face.AddItem Screen.Fonts(I%)
  138.     Next I%
  139.     ' restore screen font to default
  140.     FontName = Screen.Fonts(0)
  141.     ' select first item in list box
  142.     Lst_Face.ListIndex = 0
  143.     ' Add list of font sizes to list box
  144.     For J% = 6 To 30 Step 2
  145.         Lst_Size.AddItem Str$(J%)
  146.     Next J%
  147.     ' Select fourth item is list box
  148.     Lst_Size.ListIndex = 3
  149.     ' Select normal font characteristic (TRUE)
  150.     Opt_Norm.Value = -1
  151. End Sub
  152. Sub Form_Paint ()
  153.     ' Repaint picture box after covered by another window
  154.     ' This may also be accomplished by setting AutoDraw = True
  155.     Pict_Font.Cls
  156.     Pict_Font.Print ; FaceName$
  157. End Sub
  158. Sub Form_Resize ()
  159.     ' Repaint picture when form is resized
  160.     Pict_Font.Cls
  161.     Pict_Font.Print ; FaceName$
  162. End Sub
  163. Sub Lst_Face_Click ()
  164.     ' Display selected font
  165.     ' Clear picure box
  166.     Pict_Font.Cls
  167.     ' Set variable to item chosen in list box
  168.     FaceName$ = Lst_Face.List(Lst_Face.ListIndex)
  169.     ' Change picture font to one chosen
  170.     Pict_Font.FontName = FaceName$
  171.     ' Display it
  172.     Pict_Font.Print ; FaceName$
  173. End Sub
  174. Sub Lst_Size_Click ()
  175.     ' Display font in selected size
  176.     ' Clear picure box
  177.     Pict_Font.Cls
  178.     ' set variable to item chosen in list box
  179.     FaceSize = Val(Lst_Size.List(Lst_Size.ListIndex))
  180.     ' Change font size to one chosen
  181.     Pict_Font.FontSize = FaceSize
  182.     ' Display it
  183.     Pict_Font.Print ; FaceName$
  184. End Sub
  185. Sub Opt_Bold_Click ()
  186.     ' When Bold is chosen
  187.     ' Set font attribute to Bold (TRUE) and turn Italic off (FALSE)
  188.     Pict_Font.FontBold = -1
  189.     Pict_Font.FontItalic = 0
  190.     ' Clear picture box
  191.     Pict_Font.Cls
  192.     ' Display it
  193.     Pict_Font.Print ; FaceName$
  194. End Sub
  195. Sub Opt_Ital_Click ()
  196.     ' When Italic is chosen
  197.     ' Set font attribute to italic (TRUE) and turn "bold" off (FALSE)
  198.     Pict_Font.FontBold = 0
  199.     Pict_Font.FontItalic = -1
  200.     ' Clear picture box
  201.     Pict_Font.Cls
  202.     ' Display it
  203.     Pict_Font.Print ; FaceName$
  204. End Sub
  205. Sub Opt_Norm_Click ()
  206.     ' When Normal is chosen
  207.     ' Set font attribute to Normal by setting Bold and Italic to FALSE(0)
  208.     Pict_Font.FontBold = 0
  209.     Pict_Font.FontItalic = 0
  210.     ' Clear picture box
  211.     Pict_Font.Cls
  212.     ' Display it
  213.     Pict_Font.Print ; FaceName$
  214. End Sub
  215.